home *** CD-ROM | disk | FTP | other *** search
/ X User Tools / X User Tools (O'Reilly and Associates)(1994).ISO / sun4c / archive / tcltk.z / tcltk / slib / tk / demos / rmt < prev    next >
Text File  |  1994-09-20  |  5KB  |  165 lines
  1. #!///////////////////////////////////////////////////////////////////////////usr/STAGE/bin/wish -f
  2. #
  3. # This script implements a simple remote-control mechanism for
  4. # Tk applications.  It allows you to select an application and
  5. # then type commands to that application.
  6.  
  7. wm title . "Tk Remote Controller"
  8. wm iconname . "Tk Remote"
  9. wm minsize . 1 1
  10.  
  11. # The global variable below keeps track of the remote application
  12. # that we're sending to.  If it's an empty string then we execute
  13. # the commands locally.
  14.  
  15. set app "local"
  16.  
  17. # The global variable below keeps track of whether we're in the
  18. # middle of executing a command entered via the text.
  19.  
  20. set executing 0
  21.  
  22. # The global variable below keeps track of the last command executed,
  23. # so it can be re-executed in response to !! commands.
  24.  
  25. set lastCommand ""
  26.  
  27. # Create menu bar.  Arrange to recreate all the information in the
  28. # applications sub-menu whenever it is cascaded to.
  29.  
  30. frame .menu -relief raised -bd 2
  31. pack .menu -side top -fill x
  32. menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
  33. menu .menu.file.m
  34. .menu.file.m add cascade -label "Select Application" -command fillAppsMenu \
  35.     -menu .menu.file.m.apps -underline 0
  36. .menu.file.m add command -label "Quit" -command "destroy ." -underline 0
  37. menu .menu.file.m.apps
  38. pack .menu.file -side left
  39. tk_menuBar .menu .menu.file
  40.  
  41. # Create text window and scrollbar, and set up bindings for text
  42. # window to foward commands to a remote application.
  43.  
  44. text .t -relief raised -bd 2 -yscrollcommand ".s set" -setgrid true
  45. scrollbar .s -relief flat -command ".t yview"
  46. pack .s -side right -fill both
  47. pack .t -side left
  48.  
  49. bind .t <1> {
  50.     set tk_priv(selectMode) char
  51.     %W mark set anchor @%x,%y
  52.     if {[lindex [%W config -state] 4] == "normal"} {focus %W}
  53. }
  54. bind .t <Double-1> {
  55.     set tk_priv(selectMode) word
  56.     tk_textSelectTo %W @%x,%y
  57. }
  58. bind .t <Triple-1> {
  59.     set tk_priv(selectMode) line
  60.     tk_textSelectTo %W @%x,%y
  61. }
  62. bind .t <Control-u> {
  63.     .t delete {promptEnd + 1 char} insert
  64.     .t yview -pickplace insert
  65. }
  66. bind .t <Return> {.t insert insert \n; invoke}
  67. bind .t <BackSpace> backspace
  68. bind .t <Delete> backspace
  69. bind .t <Control-h> backspace
  70. bind .t <Control-v> {
  71.     .t insert insert [selection get]
  72.     .t yview -pickplace insert
  73.     if [string match *.0 [.t index insert]] {
  74.     invoke
  75.     }
  76. }
  77.  
  78. .t tag configure bold -font *-Courier-Bold-R-Normal-*-120-*
  79.  
  80. # The procedure below is used to print out a prompt at the
  81. # insertion point (which should be at the beginning of a line
  82. # right now).
  83.  
  84. proc prompt {} {
  85.     global app
  86.     .t insert insert "$app: "
  87.     .t mark set promptEnd {insert - 1 char}
  88.     .t tag add bold {promptEnd linestart} promptEnd
  89. }
  90.  
  91. # The procedure below executes a command (it takes everything on the
  92. # current line after the prompt and either sends it to the remote
  93. # application or executes it locally, depending on "app".
  94.  
  95. proc invoke {} {
  96.     global app executing lastCommand
  97.     set cmd [.t get promptEnd+1c insert]
  98.     incr executing 1
  99.     if [info complete $cmd] {
  100.     if {$cmd == "!!\n"} {
  101.         set cmd $lastCommand
  102.     } else {
  103.         set lastCommand $cmd
  104.     }
  105.     if {$app == "local"} {
  106.         set result [catch [list uplevel #0 $cmd] msg]
  107.     } else {
  108.         set result [catch [list send $app $cmd] msg]
  109.     }
  110.     if {$result != 0} {
  111.         .t insert insert "Error: $msg\n"
  112.     } else {
  113.         if {$msg != ""} {
  114.         .t insert insert $msg\n
  115.         }
  116.     }
  117.     prompt
  118.     .t mark set promptEnd insert-1c
  119.     }
  120.     incr executing -1
  121.     .t yview -pickplace insert
  122. }
  123.  
  124. # The following procedure is invoked to change the application that
  125. # we're talking to.  It also updates the prompt for the current
  126. # command, unless we're in the middle of executing a command from
  127. # the text item (in which case a new prompt is about to be output
  128. # so there's no need to change the old one).
  129.  
  130. proc newApp appName {
  131.     global app executing
  132.     set app $appName
  133.     if !$executing {
  134.     .t delete "promptEnd linestart" promptEnd
  135.     .t insert promptEnd "$appName:"
  136.     .t tag add bold "promptEnd linestart" promptEnd
  137.     }
  138.     return {}
  139. }
  140.  
  141. # The following procedure below handles backspaces, being careful not
  142. # to backspace over the prompt.
  143.  
  144. proc backspace {} {
  145.     if {[.t index promptEnd] != [.t index {insert - 1 char}]} {
  146.     .t delete insert-1c insert
  147.     .t yview -pickplace insert
  148.     }
  149. }
  150.  
  151. # The procedure below will fill in the applications sub-menu with a list
  152. # of all the applications that currently exist.
  153.  
  154. proc fillAppsMenu {} {
  155.     catch {.menu.file.m.apps delete 0 last}
  156.     foreach i [lsort [winfo interps]] {
  157.     .menu.file.m.apps add command -label $i -command [list newApp $i]
  158.     }
  159.     .menu.file.m.apps add command -label local -command {newApp local}
  160. }
  161.  
  162. set app [winfo name .]
  163. prompt
  164. focus .t
  165.